home *** CD-ROM | disk | FTP | other *** search
/ Light ROM 1 / LIGHT-ROM 1 (Amiga Library Services)(1994).iso / ffdisks / d893.lha / Clouds / Clouds2.9.pas < prev    next >
Pascal/Delphi Source File  |  1993-06-21  |  24KB  |  519 lines
  1. PROGRAM Cloudy;
  2.  
  3. {************************************************
  4.  ************************************************
  5.  ****                                        ****
  6.  ****              Clouds 2.9                ****
  7.  ****                                        ****
  8.  ****         by Danny Amor in 1993          ****
  9.  ****                                        ****
  10.  ****         using KICK-PASCAL 2.1          ****
  11.  ****                                        ****
  12.  ************************************************
  13.  ************************************************}
  14.  
  15. {$OPT q}
  16.  
  17. USES SupportIntuition,Intuition,IFF;
  18.  
  19. {$incl "libraries/asl.h", "asl.lib","libraries/dosextens.h"}
  20.  
  21. CONST ObereFarbe        = 31;
  22.       UntereFarbe       =  2;
  23.       MittlereFarbe     = 17;
  24.  
  25. TYPE IDt0 = ARRAY[1..1280] OF INTEGER;
  26.      IDt1 = ARRAY[1..10]   OF INTEGER;
  27.      STR_100 = STRING[100];
  28.  
  29. VAR Scr                                         : ^Screen;
  30.     Win,Win2                                    : ^Window;
  31.     Msg                                         : ^IntuiMessage;
  32.     Rp                                          : ^Rastport;
  33.     Vp, OldPtr                                  : PTR;
  34.     MyProcess                                   : ^Process;
  35.     FailName,Titl                               : STRING[256];
  36.     ab,na,num_iter,nk,n1,n,farbe,
  37.     farbe1,farbe2,farbe3,farbe4                 : WORD;
  38.     Ok,Ende                                     : BOOLEAN;
  39.     mu,mf                                       : REAL;
  40.     cloudybDt0,cloudybDt1,cloudybDt4,cloudybDt5 : IDt1;
  41.     cloudytattr0                                : TextAttr;
  42.     cloudyitxt0 ,cloudyitxt1 ,cloudyitxt2,
  43.     cloudyitxt3 ,cloudyitxt4 ,cloudyitxt5,
  44.     cloudyitxt6 ,cloudyitxt7 ,cloudyitxt8,
  45.     cloudyitxt9 ,cloudyitxt12,cloudyitxt11      : IntuiText;
  46.     cloudyimage0                                : Image;
  47.     cloudyiDT0                                  : ^IDt0;
  48.     cloudyborder0,cloudyborder1,cloudyborder4,
  49.     cloudyborder5                               : Border;
  50.     cloudygadget0,cloudygadget1,cloudygadget2,
  51.     cloudygadget3,cloudygadget4,cloudygadget5,
  52.     cloudygadget6,cloudygadget7,cloudygadget8,
  53.     cloudygadget9                               : Gadget;
  54.     clouds0                                     : Requester;
  55.     AktGad                                      : ^Gadget;
  56.     resz                                        : LONG;
  57.     resx,resy                                   : INTEGER;
  58.     it1,it2,it3,it4,it5,itxt2,itxt3,RUS,YES,NO  : IntuiText;
  59.     Req                                         : p_FileRequester;
  60.     Tags                                        : ARRAY[0..5] OF TagItem;
  61.     x,y,mode                                    : LONG;
  62.  
  63.  
  64. PROCEDURE ShowGadgets(w: p_Window);
  65.  
  66. VAR a: BOOLEAN;
  67.  
  68. BEGIN
  69.   cloudytattr0:=TextAttr("topaz.font",8,0,99);
  70.   cloudyitxt0:=IntuiText(25,0,0,16,3,^cloudytattr0,"QUIT",NIL);
  71.   cloudyitxt1:=IntuiText(25,27,0,16,3,^cloudytattr0,"SIZE",NIL);
  72.   cloudyitxt2:=IntuiText(25,27,0,4,3,^cloudytattr0,"4",NIL);
  73.   cloudyitxt3:=IntuiText(25,27,0,4,3,^cloudytattr0,"3",NIL);
  74.   cloudyitxt4:=IntuiText(25,27,0,4,3,^cloudytattr0,"2",NIL);
  75.   cloudyitxt5:=IntuiText(25,27,0,4,3,^cloudytattr0,"1",NIL);
  76.   cloudyitxt6:=IntuiText(1,0,0,8,3,^cloudytattr0,"",NIL);
  77.   cloudyitxt7:=IntuiText(25,27,0,4,3,^cloudytattr0,"ANIMATE",NIL);
  78.   cloudyitxt8:=IntuiText(25,0,0,8,3,^cloudytattr0,"SMOOTH",NIL);
  79.   cloudyitxt9:=IntuiText(25,0,0,16,3,^cloudytattr0,"SAVE",NIL);
  80.   cloudyitxt11:=IntuiText(1,0,2,3,75,^cloudytattr0,"1993 by",^cloudyitxt12);
  81.   cloudyitxt12:=IntuiText(1,0,2,4,87,^cloudytattr0,"D. Amor",NIL);
  82.   cloudyiDt0:=Ptr(Alloc_Mem(SizeOf(Idt0),2));
  83.   cloudyiDt0^:=IDt0(2687  ,-2245  ,-32230  ,678  ,24531  ,7313  ,-7301  ,-30724  ,-7678  ,-4221  ,-22346,
  84.   -31354  ,11313  ,-556  ,4003  ,-18938  ,-19131  ,-25035  ,-22925  ,30902  ,2927  ,-4646  ,-30028  ,-19184  ,-12944  ,2050  ,3598,
  85.   20466  ,-12812  ,15751  ,-19174  ,14297  ,-2610  ,19404  ,-32016  ,14996  ,-1812  ,-26046  ,-12023  ,6576  ,12971  ,29272  ,3409,
  86.   7608  ,12027  ,-7198  ,22644  ,23582  ,1393  ,-25024  ,-17419  ,30678  ,13605  ,-6788  ,-26675  ,27343  ,2834  ,-11157  ,5102,
  87.   8970  ,27401  ,-7106  ,1878  ,-20239  ,-26263  ,672  ,30311  ,-15117  ,4291  ,4172  ,-2365  ,-7774  ,27978  ,22021  ,-22205,
  88.   -8924  ,-25218  ,-19554  ,-26861  ,-7510  ,23694  ,20757  ,-6859  ,-2475  ,15612  ,-11939  ,31715  ,-1812  ,-26666  ,9834  ,-9604,
  89.   -5817  ,10344  ,6827  ,25815  ,-11646  ,-3984  ,4691  ,2311  ,29272  ,31052  ,-2474  ,29300  ,-3107  ,8741  ,5784  ,16902,
  90.   1169  ,18680  ,-24210  ,-24289  ,4828  ,-22833  ,12513  ,-15929  ,-29761  ,30037  ,8396  ,-23373  ,-29675  ,2505  ,-12890  ,-10640,
  91.   22329  ,-6424  ,2876  ,14032  ,-9871  ,-14106  ,9933  ,-13443  ,29063  ,-2508  ,-23827  ,132  ,-114  ,-16415  ,-7321  ,-10832,
  92.   -14086  ,26642  ,-2904  ,-20898  ,23977  ,-21334  ,-18124  ,-21412  ,9598  ,-25307  ,19724  ,6354  ,20872  ,-29128  ,6628  ,18035,
  93.   -25504  ,-15770  ,-28205  ,-9334  ,9053  ,29599  ,10538  ,28980  ,19058  ,-26776  ,-22075  ,21494  ,-28051  ,-25177  ,-24316  ,17846,
  94.   29994  ,-7372  ,32529  ,18034  ,-27890  ,30010  ,8352  ,22246  ,-27610  ,14481  ,7002  ,-8461  ,-12746  ,-26607  ,8283  ,27475,
  95.   24546  ,-4810  ,-15395  ,8118  ,-20525  ,27973  ,9839  ,12352  ,-20114  ,22983  ,13230  ,-25032  ,25966  ,-21361  ,-16827  ,-20897,
  96.   -12772  ,-31151  ,-22048  ,-18278  ,862  ,-21055  ,5354  ,-2715  ,-22226  ,-20486  ,-19607  ,-12677  ,6114  ,17134  ,7685  ,-5419,
  97.   5978  ,11670  ,10079  ,26525  ,31713  ,2328  ,-19773  ,31556  ,17899  ,-20536  ,10555  ,-30923  ,15508  ,18600  ,1605  ,6901,
  98.   -22849  ,5918  ,-25967  ,23860  ,-25371  ,-29992  ,30560  ,30297  ,23217  ,23102  ,23671  ,13593  ,28396  ,15564  ,17163  ,14508,
  99.   -5192  ,-11808  ,27733  ,-8902  ,20992  ,19711  ,29598  ,9940  ,-14977  ,27395  ,-11347  ,-15190  ,28219  ,11252  ,9989  ,-16741,
  100.   30651  ,-10362  ,-31260  ,-17657  ,9448  ,-14781  ,-158  ,23104  ,-2445  ,194  ,6489  ,1410  ,-28656  ,-7292  ,-8957  ,-12603,
  101.   -24211  ,-22333  ,-7078  ,25327  ,-32226  ,30624  ,32173  ,21843  ,14383  ,15617  ,16704  ,-7534  ,-15943  ,27116  ,26884  ,12659,
  102.   6463  ,296  ,-3373  ,4888  ,17405  ,-6090  ,-8969  ,9299  ,-2533  ,-7594  ,-4420  ,4678  ,-21695  ,-9559  ,21318  ,7428,
  103.   6414  ,-2426  ,-76  ,-23258  ,6830  ,15818  ,28596  ,-18122  ,-23917  ,-6292  ,18047  ,-9125  ,-5659  ,-26121  ,-19478  ,-25773,
  104.   -6363  ,22810  ,2794  ,-28455  ,26585  ,-1947  ,-16676  ,-14079  ,-16412  ,-21325  ,19361  ,28774  ,27438  ,-27214  ,-17723  ,13002,
  105.   362  ,-2313  ,7972  ,-6136  ,14707  ,5992  ,-16560  ,-18463  ,-27633  ,-6302  ,12965  ,-18610  ,15305  ,-13751  ,16440  ,17011,
  106.   -13905  ,-30332  ,32465  ,-29565  ,10645  ,-26163  ,-18288  ,-28462  ,-18595  ,-3462  ,16397  ,-2492  ,22081  ,-24085  ,13787  ,-29309,
  107.   4953  ,-5943  ,22179  ,2651  ,-8087  ,1015  ,26638  ,7674  ,-25390  ,17707  ,17385  ,-27674  ,-17549  ,-2256  ,23071  ,-10263,
  108.   2956  ,26627  ,12995  ,5948  ,9610  ,22105  ,-24114  ,-27244  ,20407  ,-5105  ,-4910  ,-4193  ,-12239  ,-2891  ,-4800  ,-5556,
  109.   10589  ,-639  ,-10540  ,-667  ,-20560  ,-27191  ,-30836  ,-12005  ,32146  ,-29807  ,-7581  ,-3201  ,-1145  ,-14862  ,17761  ,-19512,
  110.   -25470  ,1893  ,2591  ,-13769  ,-7726  ,-28800  ,-9955  ,-7107  ,-770  ,-2859  ,8525  ,-12285  ,21398  ,-30739  ,-1118  ,-5051,
  111.   29853  ,-10926  ,32164  ,18927  ,-1239  ,-24056  ,-31165  ,-10449  ,32319  ,-5805  ,28280  ,-5761  ,-21213  ,-12153  ,-9091  ,-19439,
  112.   -22134  ,26657  ,1850  ,-14147  ,15889  ,8841  ,-21698  ,11264  ,-8773  ,6602  ,-13443  ,30266  ,-21068  ,29324  ,-29156  ,-25459,
  113.   -2842  ,-3521  ,-8516  ,11263  ,13022  ,-30289  ,7988  ,-2284  ,-21534  ,-14947  ,-24517  ,16037  ,30620  ,310  ,-5336  ,-11883,
  114.   21871  ,-15211  ,-19404  ,-9462  ,25173  ,-24568  ,-10469  ,8664  ,1011  ,-25423  ,7968  ,2539  ,-25481  ,-7821  ,-427  ,-18586,
  115.   13179  ,-29370  ,32007  ,-27478  ,-24271  ,-1025  ,-7966  ,32551  ,32176  ,-1540  ,-7750  ,-14909  ,-18114  ,-5685  ,-9337  ,18661,
  116.   26767  ,3264  ,-26140  ,26740  ,30979  ,-6983  ,-32766  ,-4593  ,-7926  ,25658  ,-32223  ,-4922  ,-5143  ,-26887  ,19453  ,-32412,
  117.   -9874  ,23287  ,-6211  ,-32700  ,-401  ,2943  ,-909  ,-24562  ,20534  ,6385  ,-9951  ,636  ,16846  ,-23487  ,-1636  ,-14524,
  118.   8912  ,-5055  ,1407  ,-25393  ,-17902  ,-4897  ,6522  ,15379  ,-969  ,28164  ,11840  ,7200  ,-12187  ,26252  ,8853  ,5258,
  119.   14867  ,19980  ,1110  ,9867  ,-13026  ,-31378  ,12406  ,16363  ,-989  ,-25744  ,14783  ,7047  ,-2570  ,-19488  ,3094  ,22471,
  120.   -5830  ,-24022  ,8711  ,29719  ,-3026  ,-6001  ,24527  ,3302  ,25769  ,9375  ,-16790  ,-32303  ,-31817  ,6062  ,-11944  ,-13335,
  121.   -24693  ,16335  ,-100  ,4588  ,12698  ,8091  ,30528  ,16623  ,-2148  ,31647  ,-2512  ,2185  ,-3498  ,13431  ,23600  ,14860,
  122.   16052  ,-18445  ,31987  ,28708  ,1768  ,-18189  ,-18349  ,10475  ,-20368  ,-20379  ,16859  ,-31015  ,21528  ,8597  ,10213  ,31562,
  123.   21228  ,4249  ,2000  ,7634  ,-14344  ,12422  ,28287  ,-29570  ,3451  ,2128  ,-7169  ,-30655  ,20474  ,-30340  ,8412  ,-11156,
  124.   16185  ,7709  ,-5950  ,-2376  ,559  ,-19241  ,-25273  ,-40  ,-502  ,11391  ,-9917  ,6651  ,11780  ,12316  ,14535  ,-18023,
  125.   22336  ,30976  ,3031  ,1305  ,31681  ,-9469  ,-26243  ,3858  ,16133  ,-3325  ,-7266  ,4086  ,15624  ,9834  ,-14690  ,-28829,
  126.   9175  ,5354  ,3009  ,-13836  ,3882  ,-29073  ,6589  ,7616  ,-31973  ,-178  ,14798  ,15595  ,-16289  ,3929  ,-1245  ,11915,
  127.   -2537  ,-8504  ,25919  ,-8281  ,-13538  ,-11161  ,22716  ,32041  ,-11753  ,5429  ,-32577  ,30527  ,-24406  ,-32573  ,-15730  ,-24785,
  128.   -24107  ,-5899  ,15552  ,10337  ,350  ,-4357  ,-25549  ,-3074  ,-24828  ,-455  ,-25475  ,-1539  ,23615  ,-27867  ,4159  ,-690,
  129.   31611  ,29181  ,-1797  ,-9089  ,3715  ,20129  ,14268  ,5212  ,28379  ,16551  ,9532  ,6228  ,-53  ,-13940  ,11129  ,3716,
  130.   -1088  ,18411  ,-18225  ,9785  ,122  ,1781  ,-11314  ,7723  ,-29188  ,23217  ,20808  ,17928  ,5002  ,29943  ,-937  ,2274,
  131.   15382  ,28824  ,-1448  ,19161  ,-16335  ,2047  ,-254  ,7  ,-576  ,2047  ,-448  ,14851  ,-64  ,6143  ,-904  ,-2297,
  132.   -144  ,1023  ,32283  ,-2169  ,-4  ,-7170  ,32765  ,-3697  ,-4  ,25597  ,32767  ,-3322  ,-2  ,-3586  ,14335  ,-124,
  133.   -144  ,-1544  ,7167  ,-128  ,-400  ,-1808  ,1023  ,-128  ,30776  ,-1026  ,9983  ,-640  ,16880  ,-7170  ,1635  ,-1912,
  134.   992  ,-7170  ,0  ,-8192  ,992  ,-7200  ,6145  ,-16372  ,1984  ,-7688  ,11779  ,-8161  ,924  ,-16016  ,520  ,-6017,
  135.   -15365  ,-15888  ,1033  ,-10113  ,-3585  ,-32110  ,9  ,-16353  ,-1796  ,-32640  ,0  ,-8129  ,-1544  ,-32768  ,1  ,-8129,
  136.   -3792  ,-32758  ,8705  ,-5137  ,-2000  ,-8049  ,-61  ,-3073  ,-1998  ,9375  ,-25  ,-1  ,-968  ,6078  ,-57  ,-521,
  137.   -500  ,16383  ,-125  ,-13  ,-12772  ,8187  ,-2225  ,-16  ,2064  ,32767  ,-2545  ,-16  ,3160  ,15999  ,23567  ,-528,
  138.   184  ,16383  ,31948  ,-8  ,254  ,14591  ,-18228  ,-196  ,-20354  ,12415  ,16832  ,31038  ,21534  ,8703  ,10208  ,60,
  139.   21118  ,247  ,2032  ,44  ,-16258  ,249  ,28287  ,-32768  ,636  ,127  ,-7169  ,-32712  ,124  ,-32385  ,-7969  ,-11248,
  140.   62  ,31  ,-7997  ,-2496  ,44  ,-30465  ,-32313  ,31776  ,-452  ,4223  ,-15933  ,-2045  ,-450  ,2108  ,8647  ,-2047,
  141.   -130  ,256  ,983  ,-767  ,-2  ,8963  ,-32259  ,-237  ,-2  ,771  ,-7169  ,-9  ,-7  ,2018  ,-14337  ,32739,
  142.   -13  ,2016  ,3070  ,14327  ,-5  ,-28704  ,6594  ,1023  ,32740  ,-64  ,14768  ,1020  ,16352  ,-28735  ,-1060  ,4604,
  143.   2528  ,-8256  ,26048  ,8280  ,13543  ,-2080  ,192  ,214  ,11751  ,-272  ,192  ,192  ,24535  ,32576  ,240  ,24816,
  144.   24544  ,6130  ,-16129  ,-2050  ,-160  ,4600  ,24639  ,-1  ,32568  ,504  ,24701  ,-1  ,-968  ,3564  ,-8129  ,-49,
  145.   -3972  ,4092  ,255  ,-1  ,284  ,14240  ,-13377  ,-2084  ,4500  ,16256  ,-9921  ,-12  ,16  ,14209  ,-11399  ,-140,
  146.   112  ,15232  ,16639  ,-8  ,96  ,32258  ,9215  ,-8  ,4064  ,9806  ,-24193  ,-8  ,8176  ,3080  ,104  ,-226,
  147.   16352  ,3073  ,-32672  ,16135  ,-50  ,-1  ,-3  ,-8  ,512  ,-1  ,-1  ,-4  ,0  ,-1  ,-1  ,-8,
  148.   0  ,-1  ,-1  ,-8  ,0  ,8191  ,-1  ,-16  ,0  ,-24577  ,-1  ,-7  ,0  ,4095  ,-1  ,-5,
  149.   128  ,2047  ,-1  ,-1  ,384  ,2047  ,-1  ,-1  ,-30784  ,2047  ,-1  ,-1  ,-16896  ,8191  ,-1  ,-1,
  150.   -1024  ,8191  ,-1  ,-1  ,-1024  ,8191  ,-6145  ,-1  ,-2048  ,8191  ,-11777  ,-1  ,-1022  ,16383  ,-513  ,-1,
  151.   -1018  ,16383  ,-1025  ,-1  ,-512  ,32765  ,-1  ,-1  ,-256  ,32767  ,-1  ,-1  ,-512  ,32767  ,-1  ,-1,
  152.   -320  ,32757  ,-8705  ,-1  ,-64  ,8048  ,63  ,-1  ,-64  ,-9376  ,31  ,-1  ,-64  ,-6079  ,63  ,-1,
  153.   -16  ,-16384  ,127  ,-1  ,-32  ,-8188  ,2239  ,-1  ,-32  ,-32768  ,2559  ,-1  ,-96  ,-16000  ,-23553  ,-1,
  154.   -192  ,-16384  ,-31937  ,-1  ,-256  ,-14592  ,18239  ,-1  ,20352  ,-12416  ,-16833  ,-1  ,-21536  ,-8704  ,-10209  ,-1,
  155.   -21120  ,-256  ,-2033  ,-1  ,16256  ,-256  ,-28288  ,32767  ,-128  ,-128  ,7168  ,32767  ,-128  ,32384  ,7968  ,11263,
  156.   -64  ,-32  ,7996  ,2559  ,-48  ,32512  ,32312  ,1023  ,448  ,-128  ,15932  ,2044  ,448  ,-61  ,-8648  ,2046,
  157.   128  ,-257  ,-984  ,766  ,0  ,-772  ,32258  ,236  ,0  ,-772  ,7168  ,8  ,6  ,-2019  ,14336  ,28,
  158.   14  ,-2017  ,-3072  ,8  ,4  ,28703  ,-6656  ,0  ,0  ,63  ,-14848  ,0  ,0  ,28734  ,1024  ,0,
  159.   0  ,8255  ,-26112  ,0  ,0  ,2079  ,-256  ,0  ,2  ,15  ,-256  ,0  ,0  ,63  ,-256  ,0,
  160.   0  ,15  ,-256  ,0  ,128  ,7  ,-64  ,0  ,192  ,7  ,-126  ,0  ,960  ,19  ,-64  ,48,
  161.   3968  ,3  ,-256  ,0  ,-32  ,95  ,-960  ,2083  ,-32  ,127  ,-320  ,11  ,-32  ,127  ,-890  ,11,
  162.   -128  ,127  ,-256  ,7  ,-128  ,511  ,-1024  ,7  ,-4096  ,511  ,-384  ,7  ,-8192  ,1023  ,-128  ,1,
  163.   -16384  ,1023  ,-128  ,0  ,0  );
  164.   cloudyimage0:=Image(0, 0, 64, 64, 5,cloudyiDt0, 31, 0,NIL);
  165.   cloudybDt0:=IDt1(1,1,1,12,0,13,0,0,62,0);
  166.   cloudyborder0:=Border(0, 0, 26, 0, 0, 5,^cloudybDt0,^cloudyborder1);
  167.   cloudybDt1:=IDt1(62,13,62,1,63,0,63,13,1,13);
  168.   cloudyborder1:=Border(0, 0, 1, 0, 0, 5,^cloudybDt1,NIL);
  169.   cloudybDt4:=IDt1(1,1,1,12,0,13,0,0,14,0);
  170.   cloudyborder4:=Border(0, 0, 26, 0, 0, 5,^cloudybDt4,^cloudyborder5);
  171.   cloudybDt5:=IDt1(14,13,14,1,15,0,15,13,1,13);
  172.   cloudyborder5:=Border(0, 0, 1, 0, 0, 5,^cloudybDt5,NIL);
  173.   cloudygadget0:=Gadget(^cloudygadget1, 0, 175, 64, 14, GADGHCOMP, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder0, NIL, ^cloudyitxt0,0, NIL, 0, PTR(-1));
  174.   cloudygadget1:=Gadget(^cloudygadget2, 0, 98, 64, 14, GADGHNONE, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder0, NIL, ^cloudyitxt1,0, NIL, 1, PTR(-1));
  175.   cloudygadget2:=Gadget(^cloudygadget3, 48, 112, 16, 14, GADGHCOMP, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder4, NIL, ^cloudyitxt2,0, NIL, 2, PTR(-1));
  176.   cloudygadget3:=Gadget(^cloudygadget4, 32, 112, 16, 14, GADGHCOMP, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder4, NIL, ^cloudyitxt3,0, NIL, 3, PTR(-1));
  177.   cloudygadget4:=Gadget(^cloudygadget5, 16, 112, 16, 14, GADGHCOMP, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder4, NIL, ^cloudyitxt4,0, NIL, 4, PTR(-1));
  178.   cloudygadget5:=Gadget(^cloudygadget6, 0, 112, 16, 14, GADGHCOMP, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder4, NIL, ^cloudyitxt5,0, NIL, 5, PTR(-1));
  179.   cloudygadget6:=Gadget(^cloudygadget7, 0, 7, 64, 64, GADGHNONE+GADGIMAGE, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyimage0, NIL, ^cloudyitxt6,0, NIL, 6, PTR(-1));
  180.   cloudygadget7:=Gadget(^cloudygadget8, 0, 130, 64, 14, GADGHCOMP, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder0, NIL, ^cloudyitxt7,0, NIL, 7, PTR(-1));
  181.   cloudygadget8:=Gadget(^cloudygadget9, 0, 145, 64, 14, GADGHCOMP, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder0, NIL, ^cloudyitxt8,0, NIL, 8, PTR(-1));
  182.   cloudygadget9:=Gadget(NIL, 0, 160, 64, 14, GADGHCOMP, RELVERIFY+GADGIMMEDIATE, BOOLGADGET+REQGADGET, ^cloudyborder0, NIL, ^cloudyitxt9,0, NIL, 9, PTR(-1));
  183.   InitRequester( ^clouds0);
  184.   clouds0.LeftEdge := 0;
  185.   clouds0.TopEdge := 10;
  186.   clouds0.Width := 64;
  187.   clouds0.Height := 200;
  188.   clouds0.ReqGadget := ^cloudygadget0;
  189.   clouds0.ReqBorder := NIL;
  190.   clouds0.ReqText := ^cloudyitxt11;
  191.   clouds0.Flags := 0;
  192.   clouds0.BackFill := 0;
  193.   a:=Request(^clouds0,w);
  194. END;
  195.  
  196. PROCEDURE TestF(VAR farbe: WORD);
  197.  
  198. BEGIN
  199.   IF farbe>ObereFarbe THEN farbe:=ObereFarbe;
  200.   IF farbe<UntereFarbe THEN farbe:=UntereFarbe
  201. END;
  202.  
  203. PROCEDURE RandomFarbe(VAR Rp: p_RastPort; Start: WORD; VAR mf: REAL;
  204.                       x,y: INTEGER);
  205.  
  206. VAR farbe,a: WORD;
  207.  
  208. BEGIN
  209.   farbe:=Start+SUCC(ROUND(RANDOM*mf*LONG(2)-mf));
  210.   TestF(farbe);
  211.   SetAPen(Rp,farbe);
  212.   a:=WritePixel(Rp,x,y);
  213. END;
  214.  
  215. PROCEDURE Cloud;
  216.  
  217. TYPE Coord = ARRAY [1..10] OF WORD;
  218.  
  219. VAR i,j,k,l,smul1,smul2,x1,y1,x2,y2,x3,y3: WORD;
  220.     xy                                   : Coord;
  221.  
  222.   PROCEDURE BigPic(n,i: WORD; VAR n1,l: WORD);
  223.  
  224.   BEGIN
  225.    n1:=n SHR 1;
  226.    IF n1=127 THEN INC(n1);
  227.    l:=1 SHL i;
  228.    IF l=0 THEN DEC(l);
  229.   END;
  230.  
  231.   PROCEDURE SetEdge(VAR Rp: p_RastPort; x1,y1,x2,y2,x3,y3: WORD;
  232.                     VAR mf: REAL);
  233.  
  234.   BEGIN
  235.     farbe1:=ReadPixel(Rp,x1,y1);
  236.     farbe2:=ReadPixel(Rp,x2,y2);
  237.     RandomFarbe(Rp,(farbe1+farbe2) SHR 1,mf,x3,y3);
  238.   END;
  239.  
  240.   PROCEDURE SetPoint(VAR Rp: p_RastPort; VAR mf: REAL;
  241.                      VAR xy: Coord);
  242.  
  243.   VAR a: INTEGER;
  244.  
  245.   BEGIN
  246.     farbe1:=ReadPixel(Rp,xy[1],xy[2]);
  247.     farbe2:=ReadPixel(Rp,xy[3],xy[4]);
  248.     farbe3:=ReadPixel(Rp,xy[5],xy[6]);
  249.     farbe4:=ReadPixel(Rp,xy[7],xy[8]);
  250.     farbe:=(farbe1+farbe2+farbe3+farbe4) SHR 2+ROUND(RANDOM*2*mf-mf);
  251.     TestF(farbe);
  252.     SetAPen(Rp,farbe);
  253.     a:=WritePixel(Rp,xy[9],xy[10]);
  254.   END;
  255.  
  256. BEGIN
  257.   SetAPen(Rp,0);
  258.   RectFill(Rp,0,0,256,256);
  259.   RANDOMIZE;
  260.   mf:=SUCC(num_iter)*mu;
  261.   RandomFarbe(Rp,MittlereFarbe,mf,0,  0);
  262.   RandomFarbe(Rp,MittlereFarbe,mf,0, na);
  263.   RandomFarbe(Rp,MittlereFarbe,mf,na, 0);
  264.   RandomFarbe(Rp,MittlereFarbe,mf,na,na);
  265.   n:=na;
  266.   FOR i:=0 TO num_iter DO
  267.   BEGIN
  268.     mf:=SUCC(num_iter-i)*mu;
  269.     Bigpic(n,i,n1,l);
  270.     FOR j:=1 TO l DO
  271.     BEGIN
  272.       smul1:=PRED(j)*n;
  273.       smul2:=j*n;
  274.       SetEdge(Rp,smul1,0    ,smul2,0    ,smul2-n1,0       ,mf);
  275.       SetEdge(Rp,smul1,na   ,smul2,na   ,smul2-n1,na      ,mf);
  276.       SetEdge(Rp,0    ,smul1,0    ,smul2,0       ,smul2-n1,mf);
  277.       SetEdge(Rp,na   ,smul1,na   ,smul2,na      ,smul2-n1,mf);
  278.     END;
  279.   n:=n1;
  280.   END;
  281.   n:=na;
  282.   FOR i:=0 TO num_iter DO
  283.   BEGIN
  284.     mf:=SUCC(num_iter-i)*mu;
  285.     BigPic(n,i,n1,l);
  286.     FOR k:=1 TO l DO
  287.       FOR j:=1 TO l DO
  288.       BEGIN
  289.         smul1:=k*n;   smul2:=j*n;
  290.         xy:=Coord(smul2-n,smul1-n,smul2-n,smul1,smul2,smul1-n,
  291.                   smul2,smul1,smul2-n1,smul1-n1);
  292.         SetPoint(Rp,mf,xy);
  293.       END;
  294.     nk:=0;
  295.     FOR k:=1 TO PRED(1 SHL SUCC(i)) DO
  296.     BEGIN
  297.       nk:=1-nk;
  298.       FOR j:=1 TO (1 SHL i)-nk DO
  299.       BEGIN
  300.         smul1:=j*n+nk*n1;   smul2:=k*n1;
  301.         xy:=Coord(smul1-n1,smul2-n1,smul1,smul2,smul1-n1,smul2+n1,
  302.                   smul1-n,smul2,smul1-n1,smul2);
  303.         SetPoint(Rp,mf,xy);
  304.       END;
  305.     END;
  306.     n:=n1;
  307.   END;
  308. END;
  309.  
  310. PROCEDURE SizeOut(VAR na,num_iter: WORD; VAR mu: REAL; faktor: WORD);
  311.  
  312. BEGIN
  313.   faktor:=7-faktor;
  314.   IF resz=0 THEN
  315.   BEGIN
  316.     na:=8 SHL faktor;
  317.     num_iter:=2+faktor;
  318.   END
  319.   ELSE
  320.   BEGIN
  321.     na:=16 SHL faktor;
  322.     num_iter:=3+faktor;
  323.   END;
  324.   mu:=2.5-faktor/5;
  325.   Cloud;
  326. END;
  327.  
  328. PROCEDURE Smooth(VAR na: WORD);
  329.  
  330. VAR y,x,a: WORD;
  331.  
  332. BEGIN
  333.   FOR y:=0 TO PRED(na) DO
  334.     FOR x:=0 TO PRED(na) DO
  335.     BEGIN
  336.       farbe1:=ReadPixel(Rp,x,y);
  337.       farbe2:=ReadPixel(Rp,SUCC(x),y);
  338.       farbe3:=ReadPixel(Rp,x,SUCC(y));
  339.       farbe4:=ReadPixel(Rp,SUCC(x),SUCC(y));
  340.       farbe :=(farbe1+farbe2+farbe3+farbe4) SHR 2;
  341.       SetAPen(Rp,farbe);
  342.       a:=WritePixel(Rp,x,y);
  343.     END;
  344. END;
  345.  
  346. PROCEDURE anim(vp: PTR);;
  347.  
  348. VAR a,i,k,nh,n: WORD;
  349.     nf: SHORT;
  350.  
  351. BEGIN
  352.   nh:=0;  nf:=1;  n:=2;
  353.   FOR k:=1 TO 22 DO
  354.   BEGIN
  355.     FOR i:=1 TO 11-nh DO
  356.     BEGIN
  357.       SetRGB4(Vp,n,0,0,15);
  358.       INC(n);
  359.     END;
  360.     FOR i:=2 TO 14 DO
  361.     BEGIN
  362.       SetRGB4(Vp,n,i,i,15);
  363.       INC(n);
  364.     END;
  365.     SetRGB4(Vp,n,15,15,15);
  366.     INC(n);
  367.     FOR i:=14 DOWNTO 10 DO
  368.     BEGIN
  369.       SetRGB4(Vp,n,i,i,SUCC(i));
  370.       INC(n);
  371.     END;
  372.     FOR i:=1 TO nh DO
  373.     BEGIN
  374.       a:=1;
  375.       IF i>2 THEN a:=5-i;
  376.       IF i>7 THEN a:=i-10;
  377.       a:=(10-a);
  378.       SetRGB4(Vp,n,a,a,SUCC(a));
  379.       INC(n);
  380.     END;
  381.     nh:=nh+nf;
  382.     IF (nh=0) OR (nh=11) THEN nf:=-nf;
  383.     n:=2;
  384.   END;
  385. END;
  386.  
  387. FUNCTION GetFileName(fname: STR_100): BOOLEAN;
  388.  
  389. VAR Req      : p_FileRequester; 
  390.     Tags     : ARRAY[0..4] OF TagItem;
  391.     FileName : STRING[100];
  392.     DirName  : STRING[100];
  393.     VailName : STRING[100];
  394.     Cancel   : Boolean;
  395.  
  396. BEGIN
  397.   AslBase:=OpenLibrary(ASLNAME,36);
  398.   IF AslBase<>NIL THEN
  399.   BEGIN
  400.     Cancel:=FALSE;
  401.     DirName :="RAM:";
  402.     FileName :="";
  403.     Tags[0].ti_Tag:=ASL_Hail;
  404.     Tags[0].ti_Data:="Save Clouds as...";
  405.     Tags[1].ti_Tag:=ASL_File;
  406.     Tags[1].ti_Data:=FileName;
  407.     Tags[2].ti_Tag:=ASL_Dir;
  408.     Tags[2].ti_Data:=DirName;
  409.     Tags[3].ti_Tag:=ASL_Dummy+40;
  410.     Tags[3].ti_Tag:=^Scr;
  411.     Tags[4].ti_Tag:=TAG_DONE;
  412.     Req:=AllocAslRequest(ASL_FileRequest,^Tags);
  413.     IF Req<>NIL THEN
  414.     BEGIN
  415.       Cancel:=RequestFile(Req);
  416.       IF NOT Cancel THEN fName:=Req^.rf_Dir+Req^.rf_File
  417.                     ELSE fName:=CHR(0);
  418.       FreeAslRequest(Req);
  419.     END;
  420.     CloseLibrary(AslBase);
  421.     GetFileName:=Cancel;
  422.   END;
  423. END;
  424.  
  425. PROCEDURE ReqHelpHelpHelp;
  426.  
  427. BEGIN
  428.   MyProcess^.pr_WindowPTR:=OldPtr;
  429. END;
  430.  
  431. BEGIN
  432.   MyProcess:=PTR(FindTask(NIL));
  433.   OldPtr:=MyProcess^.pr_WindowPTR;
  434.   MyProcess^.pr_WindowPTR:=Win;
  435.   AddExitServer(ReqHelpHelpHelp);
  436.   RUS:=IntuiText(2,1,0,5,3,NIL,'Are you sure?',NIL);
  437.   Yes:=IntuiText(2,1,0,5,3,NIL,'Yes',NIL);
  438.   No:=IntuiText(2,1,0,5,3,NIL,'No',NIL);
  439.   AslBase:=OpenLibrary(ASLNAME,38);
  440.   IF AslBase<>NIL THEN
  441.   BEGIN
  442.     Req:=AllocAslRequest(2,NIL);
  443.     IF Req<>NIL THEN
  444.     BEGIN
  445.       OK:=RequestFile(Req);
  446.       IF OK THEN
  447.       BEGIN
  448.         {I didn't have the OS 3.0-Includes, so I had to guess}
  449.         mode:=LONG(Req^.rf_Reserved1);
  450.         resx:=WORD(LONG(Req^.rf_File));
  451.         resy:=WORD(LONG(Req^.rf_Dir));
  452.         Tags[0].ti_Tag:=SA_WIDTH;    Tags[0].ti_Data:=resx;
  453.         Tags[1].ti_Tag:=SA_HEIGHT;   Tags[1].ti_Data:=resy;
  454.         Tags[2].ti_Tag:=SA_DEPTH;    Tags[2].ti_Data:=5;
  455.         Tags[3].ti_Tag:=SA_TYPE;     Tags[3].ti_Data:=CUSTOMSCREEN;
  456.         Tags[4].ti_Tag:=SA_DISPLAYID;Tags[4].ti_Data:=mode;
  457.         Tags[5].ti_Tag:=TAG_DONE;
  458.         Scr := OpenExtScreen( NIL, ^Tags, FALSE);
  459.       END
  460.       ELSE ERROR("HallO");
  461.       FreeAslRequest(Req);
  462.     END
  463.     ELSE WRITELN("Kann Struktur nicht anlegen !");
  464.     CloseLibrary(AslBase);
  465.   END
  466.   ELSE
  467.   BEGIN
  468.     it1:=IntuiText(2,1,0,5,3,NIL,"Welcome to CLOUDS v3.0!!! ",^it2);
  469.     it2:=IntuiText(2,1,0,5,13,NIL,"This program is pure Public Domain ",^it3);
  470.     it3:=IntuiText(2,1,0,5,23,NIL,"I hope you like it!!",^it4);
  471.     it4:=IntuiText(2,1,0,5,33,NIL,"You haven't got Workbench v2.1!!!",^it5);
  472.     it5:=IntuiText(2,1,0,5,43,NIL,"So you can't choose any resolution...",NIL);
  473.     itxt2:=IntuiText(2,1,0,5,3,NIL,"OK",NIL);
  474.     itxt3:=IntuiText(2,1,0,5,3,NIL,"OK",NIL);
  475.     OK:=autorequest(NIL,^it1,^itxt2,^itxt3,0,0,300,60);
  476.     resx:=320;
  477.     resy:=256;
  478.     resz:=0;
  479.     Scr:=Open_Screen(0,0,resx,resy,5,0,1,resz,NIL);
  480.   END;
  481.   Win:=Open_Window(0,0,resx,resy,0,0,BORDERLESS OR ACTIVATE,NIL,Scr,0,0,0,0);
  482.   Win2:=Open_Window(0,0,64,200,1,GADGETUP OR GADGETDOWN,
  483.                    WINDOWDRAG OR BORDERLESS OR ACTIVATE,"CLOUDS  ",Scr,0,0,0,0);
  484.   Vp:=^Scr^.ViewPort;
  485.   Rp:=Win^.RPort;
  486.   SetRGB4(Vp,0, 0, 0, 0);
  487.   SetRGB4(Vp,1,10,10,10);
  488.   Anim(vp);;
  489.   ShowGadgets(Win2);
  490.   Ende:=FALSE;
  491.   REPEAT
  492.     Msg:=Wait_Port(Win2^.UserPort);
  493.     Msg:=Get_Msg(Win2^.UserPort);
  494.     CASE Msg^.Class OF
  495.       GADGETDOWN:
  496.       BEGIN
  497.         AktGad:=Msg^.IAddress;
  498.         CASE AktGad^.GadgetID OF
  499.           0   : Ende:=AutoRequest(Win2,^RUS,^Yes,^No,0,0,100,50);
  500.           2..5: SizeOut(na,num_iter,mu,BYTE(AktGad^.GadgetID));
  501.           7   : Anim(vp);
  502.           8   : Smooth(na);
  503.           9   : BEGIN
  504.                   na:=na SHL 1;
  505.                   IF (na MOD 8)<>0 THEN ab:=SUCC(na DIV 8)
  506.                                    ELSE ab:=na DIV 8;
  507.                   IF GetFileName(FailName) THEN
  508.                     SaveBrush(Win,FailName,0,0,ab,na);
  509.                 END;
  510.           OTHERWISE BEGIN END;
  511.         END;
  512.       END;
  513.       OTHERWISE BEGIN END;
  514.     END;
  515.     Reply_Msg(Msg);
  516.   UNTIL Ende;
  517. END;
  518.  
  519.